home *** CD-ROM | disk | FTP | other *** search
/ CD ROM Paradise Collection 4 / CD ROM Paradise Collection 4 1995 Nov.iso / program / swagg_m.zip / MISC.SWG / 0021_A source code mangler.pas < prev    next >
Pascal/Delphi Source File  |  1993-07-16  |  6KB  |  228 lines
  1. {
  2. Here is a VERY simple source-code mangler that I just made. It simply:
  3.  
  4. 1) Removes whitespace,
  5. 2) Removes comments (but not Compiler-directives!),
  6. 3) Makes everything upper-Case.
  7. 4) Make lines max. 127 Chars wide (max. For Turbo Pascal),
  8. 5) Doesn't mess up literal Strings :-)
  9.  
  10. I don't imagine that this is anything Near perfect - but it's better than
  11. nothing...
  12.  
  13. }
  14.  
  15. Program Mangler;
  16.  
  17. Const
  18.   Alpha : Set of Char = ['a'..'z', 'A'..'Z', '0'..'9'];
  19.  
  20. Var
  21.   F, F2 : Text;
  22.   R, S : String;
  23.   X : Byte;
  24.   InString : Boolean;
  25.  
  26. Function NumChar(C : Char; S : String; Max : Byte) : Byte;
  27. Var
  28.   N, Y : Byte;
  29. begin
  30.   N := 0;
  31.   For Y := 1 to Max do
  32.     if S[Y] = C then Inc(N);
  33.   NumChar := N;
  34. end;
  35.  
  36. Function TrimF(T : String) : String;
  37. Var
  38.   T2 : String;
  39. begin
  40.   T2 := T;
  41.   While (Length(T2) > 0) and (T2[1] = ' ') do
  42.     Delete(T2, 1, 1);
  43.   TrimF := T2;
  44. end;
  45.  
  46. Function Trim(T : String) : String;
  47. Var
  48.   T2 : String;
  49. begin
  50.   T2 := TrimF(T);
  51.   While (Length(T2) > 0) and (T2[Length(T2)] = ' ') do
  52.     Delete(T2, Length(T2), 1);
  53.   Trim := T2;
  54. end;
  55.  
  56. Procedure StripComments(Var T : String);
  57. Var
  58.   Y : Byte;
  59.   Rem : Boolean;
  60. begin
  61.   Rem := True;
  62.   if Pos('(*', T) > 0 then
  63.   begin
  64.     For Y := Pos('(*', T) to Pos('*)', T) do
  65.       if (T[Y] = '$') or (T[Y] = '''') then
  66.         Rem := False;
  67.     if (Rem) and (not Odd(NumChar('''', T, Pos('(*', T)))) then
  68.       Delete(T, Pos('(*', T), Pos('*)', T)+2-Pos('(*', T));
  69.   end;
  70.   if Pos('{', T) > 0 then
  71.   begin
  72.     For Y := Pos('{', T) to Pos('}', T) do
  73.       if (T[Y] = '$') or (T[Y] = '''') then
  74.         Rem := False;
  75.     if (Rem) and (not Odd(NumChar('''', T, Pos('(*', T)))) then
  76.       Delete(T, Pos('{', T), Pos('}', T)+1-Pos('{', T));
  77.   end;
  78. end;
  79.  
  80. begin
  81.   ReadLn(S);
  82.   Assign(F, S);
  83.   Reset(F);
  84.   ReadLn(S);
  85.   Assign(F2, S);
  86.   ReWrite(F2);
  87.   R := '';
  88.   S := '';
  89.  
  90.   While not EoF(F) do
  91.   begin
  92.     ReadLn(F, R);
  93.     StripComments(R);
  94.     R := Trim(R);
  95.     X := 1;
  96.     While X <= Length(R) do
  97.     begin
  98.       InString := (R[X] = '''') xor InString;
  99.       if not InString then
  100.       begin
  101.         if R[X] = #9 then
  102.           R[X] := ' ';
  103.         if ((R[X] = ' ') and (R[X+1] = ' ')) then
  104.         begin
  105.           Delete(R, X, 1);
  106.           if X > 1 then
  107.             Dec(X);
  108.         end;
  109.         if ((R[X] = ' ') and not(R[X+1] in Alpha)) then
  110.           Delete(R, X, 1);
  111.         if ((R[X+1] = ' ') and not(R[X] in Alpha)) then
  112.           Delete(R, X+1, 1);
  113.         R[X] := UpCase(R[X]);
  114.       end;
  115.       Inc(X);
  116.     end;
  117.     if (Length(R) > 0) and (R[Length(R)] <> ';') then
  118.       R := R+' ';
  119.     if Length(R)+Length(S) <= 127 then
  120.       S := TrimF(S+R)
  121.     else
  122.     begin
  123.       WriteLn(F2, Trim(S));
  124.       S := TrimF(R);
  125.     end;
  126.   end;
  127.  
  128.   WriteLn(F2, S);
  129.   Close(F);
  130.   Close(F2);
  131. end.
  132. {
  133.  > 1) Remove whitespace.
  134. Just removes indentation now.
  135.  > 2) Put lines together (max. length approx. 120 Chars).
  136. This is going to be one of the harder parts.
  137.  > 3) Make everything lower-Case (or upper-Case).
  138. No need.. see 4.
  139. 4.  Convert all Types, Consts, and VarS to an encypted name, like so:
  140.      IIl0lll1O0lI1
  141. 5.  Convert all Procedures, and Functions like #4
  142. 6.  On Objects, Convert all "data" fields.  Leave alone all others except For
  143. the "ConstRUCtoR" and on that, only check to see if any Types are being used.
  144. Constructors are the only ones that can change from the ancestor.
  145. 7.  on Records, When Typed like this:
  146. aRec.Name:='Rob Green';  check to see if arec is in the list, if not, skip.
  147. if like this:
  148.    With arec do
  149.      name:='Rob Green';  do the same as above, but check For begin and end.
  150. 8.  Leave externals alone.
  151. 9.  Also mangle the Includes.
  152. 10. Leave Any Interface part alone, and only work With the Implementation.
  153. This is what my mangler currently does.(all except For #7 and #10, havent got
  154. that Far yet.)  Any ways it works pretty good.  im happy With the results i
  155. am getting With it.  It makes it "VERY" hard to read.  The only thing i see
  156. having trouble With down the line, is the "Compressing" of mulitiple lines.
  157.  
  158. Anyways, heres a small Program, and then what PAM(Pascal automatic mangler)
  159. did to it:
  160. }
  161.  
  162. Program test;
  163.  
  164. Type
  165.    pstr30 = ^str30;
  166.    str30  = String[30];
  167.  
  168. Var
  169.    b : Byte;
  170.    s : pstr30;
  171.  
  172. Function hex(b : Byte) : String;
  173. Const
  174.    Digits : Array [0..15] of Char = '0123456789ABCDEF';
  175. Var
  176.    s:String;
  177. begin
  178.    s:='';
  179.    s[0] := #2;
  180.    s[1] := Digits [b shr 4];
  181.    s[2] := Digits [b and $F];
  182.    hex:=s;
  183. end;
  184.  
  185. begin
  186.    new(s);
  187.    s^:='Hello world';
  188.    Writeln(s^);
  189.    Writeln('Enter a Byte to convert to hex:');
  190.    readln(b);
  191.    s^:=hex(b);
  192.    Writeln('Byte :',b,' = $',s^);
  193.    dispose(s);
  194. end.
  195.  
  196.  
  197. Program test;
  198. Type
  199.   IO1II0IO00O = ^II0lOl1011I;
  200.   II0lOl1011I = String[30];
  201. Var
  202.   III0O1ll10l:Byte;
  203.   I11110I11Il0:IO1II0IO00O;
  204.  
  205. Function Il00O011IO0I(III0O1ll10l:Byte):String;
  206. Const
  207.   Illl1OOOO0I : Array [0..15] of Char = '0123456789ABCDEF';
  208. Var
  209.   I11110I11Il0:String;
  210. begin
  211.   I11110I11Il0:='';
  212.   I11110I11Il0[0] := #2;
  213.   I11110I11Il0[1] := Illl1OOOO0I [III0O1ll10l shr 4];
  214.   I11110I11Il0[2] := Illl1OOOO0I [III0O1ll10l and $F];
  215.   Il00O011IO0I:=I11110I11Il0;
  216. end;
  217. begin
  218.   new(I11110I11Il0);
  219.   I11110I11Il0^:='Hello world';
  220.   Writeln(I11110I11Il0^);
  221.   Writeln('Enter a Byte to convert to hex:');
  222.   readln(III0O1ll10l);
  223.   I11110I11Il0^:=Il00O011IO0I(III0O1ll10l);
  224.   Writeln('Byte :',III0O1ll10l,' = $',I11110I11Il0^);
  225.   dispose(I11110I11Il0);
  226. end.
  227.  
  228.